home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PWAEBL11.ZIP / EBL.PPS < prev    next >
Text File  |  1995-05-11  |  11KB  |  352 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; Enhanced Bulletin Lister v1.1
  3. ; Written by Drew [PWA]
  4. ; Last updated 04-27-95
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7.  
  8.  
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ; function/procedure decl's
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. declare procedure Initialize()
  13. declare function  GetBullList() string
  14. declare function  GetMaxLength() byte
  15. declare procedure GetInput()
  16. declare procedure CheckHotKey(byte ascii, var byte currow, var byte curblt)
  17. declare procedure ParseSelected(byte curblt)
  18. declare procedure PrintMenu()
  19. declare procedure PrintBulletin(byte curblt)
  20. declare procedure PrintCredits()
  21. declare procedure PrintHighlight(byte currow)
  22. declare procedure RestoreText(byte currow)
  23. declare procedure GetManualInput(string select)
  24.  
  25.  
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ; global var's.
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. string bltlstfile     ; the BLT.LST file
  31. string bltmenu        ; the BLT menu
  32. string lb_colour      ; colour of lightbar
  33. string save_text      ; used to save and restore highlighted text
  34. byte numblt           ; number of bulletins
  35. byte startrow         ; starting row for lightbar
  36. byte startcol         ; starting column for lightbar
  37. byte numskiprow       ; number of rows to skip per lightbar movement
  38. byte lb_length        ; lightbar length
  39. boolean autopause     ; pause after displaying every bulletin
  40.  
  41.  
  42.  
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44. ; main
  45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46. begin
  47.     Initialize()
  48.     PrintMenu()
  49.     GetInput()
  50. end
  51.  
  52.  
  53.  
  54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55. ; gets input from user, moves lightbar, etc.
  56. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57. procedure GetInput()
  58.     boolean done
  59.     byte curblt
  60.     byte ascii
  61.     byte currow
  62.  
  63.     ansipos startcol, startrow
  64.     currow = startrow
  65.     PrintHighlight(currow)
  66.  
  67.     curblt = 1
  68.     done = FALSE
  69.     while (!done) do
  70.         ascii = asc(inkey())
  71.         delay 1
  72.         select case (ascii)
  73.         case 13
  74.             ; carriage return - print the bulletin, and remain in the ppe
  75.             ;
  76.             PrintBulletin(curblt)
  77.             PrintMenu()
  78.             PrintHighlight(currow)
  79.         case 76, 85, 56
  80.             ; left arrow, up arrow, 8
  81.             RestoreText(currow)
  82.             dec curblt
  83.             if (curblt < 1) curblt = numblt
  84.             currow = currow - numskiprow
  85.             if (currow < startrow) currow= startrow + ((numblt-1) * numskiprow)
  86. ;                                                           ^^^ this is the fix
  87. ;                                                               from v1.0
  88.             PrintHighlight(currow)
  89.         case 82, 68, 50
  90.             ; right arrow, down arrow, 2
  91.             RestoreText(currow)
  92.             inc curblt
  93.             if (curblt > numblt) curblt = 1
  94.             currow = currow + numskiprow
  95.             if (currow > startrow + (numblt * numskiprow) - 1) currow= startrow
  96.             PrintHighlight(currow)
  97.         case 69
  98.             ; "end"
  99.             RestoreText(currow)
  100.             curblt = numblt
  101.             currow = startrow + ((numblt-1) * numskiprow)
  102.             PrintHighlight(currow)
  103.         case 72
  104.             ; "home"
  105.             RestoreText(currow)
  106.             curblt = 1
  107.             currow = startrow
  108.             PrintHighlight(currow)
  109.         case 27, 81, 113
  110.             ; ESC, Q, q - quit
  111.             done = TRUE
  112.         default
  113.             ; make sure the parameter is the ascii # of the lower case letter.
  114.             ; variables "done" and "curblt" cat get updated here.
  115.             ;
  116.             CheckHotKey(asc(lower(chr(ascii))) - 96, currow, curblt)
  117.         endselect
  118.     endwhile
  119.  
  120.     PrintCredits()
  121. endproc
  122.  
  123.  
  124.  
  125. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  126. ; check if the user hit a hotkey corresponding to the bulletin.  if so, then
  127. ; print the bulletin and remain in the ppe
  128. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  129. procedure CheckHotKey(byte ascii, var byte currow, var byte curblt)
  130.     if ((ascii >= 1) && (ascii <= numblt)) then
  131.         RestoreText(currow)
  132.         currow = currow + ((ascii - curblt) * numskiprow)
  133.         PrintHighlight(currow)
  134.         curblt = ascii
  135.         PrintBulletin(curblt)
  136.         PrintMenu()
  137.         PrintHighlight(currow)
  138.     endif
  139. endproc
  140.  
  141.  
  142.  
  143. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  144. ; i hope no one minds. :)
  145. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146. procedure PrintCredits()
  147.     ansipos 1, u_pagelen
  148.     defcolor
  149.     println "@X08Enhanced Bulletin Lister v1.1 by Drew [PWA]@X07"
  150. endproc
  151.  
  152.  
  153.  
  154. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  155. ; save the old text and then print the lightbar
  156. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  157. procedure PrintHighlight(byte currow)
  158.     save_text = scrtext(startcol, currow, lb_length, TRUE)
  159.     ansipos startcol, currow
  160.     print lb_colour + stripatx(save_text)
  161. endproc
  162.  
  163.  
  164.  
  165. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  166. ; restore text (after moving lightbar)
  167. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  168. procedure RestoreText(byte currow)
  169.     ansipos startcol, currow
  170.     print save_text
  171. endproc
  172.  
  173.  
  174.  
  175. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  176. ; print the BLT file
  177. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  178. procedure PrintMenu()
  179.     ; make sure we clear the screen
  180.     cls
  181.     dispfile bltmenu, DEFS
  182. endproc
  183.  
  184.  
  185.  
  186. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  187. ; print the bulletin.  reads from BLT.LST automatically. :)
  188. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  189. procedure PrintBulletin(byte curblt)
  190.     string foo
  191.  
  192.     ; get the full pathname of the bulletin
  193.     ;
  194.     fopen 1, bltlstfile, O_RD, S_DW
  195.     fseek 1, (curblt-1) * 30, seek_set
  196.     fread 1, foo, 30
  197.     fclose 1
  198.  
  199.     ; show the darn bulletin, trimming any trailing spaces
  200.     ;
  201.     ansipos 1, u_pagelen
  202.     dispfile rtrim(foo, " "), DEFS
  203.     if (autopause) wait
  204. endproc
  205.  
  206.  
  207.  
  208. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  209. ; does a whole bunch of initializing.  see inline documentation for more
  210. ; details (should be straight forward).
  211. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  212. procedure Initialize()
  213.     byte numtok, i, confnum
  214.     string cnames
  215.     string ebl_cfg
  216.     string foo, foo2
  217.     string select
  218.     boolean found
  219.  
  220.  
  221.     wrunet pcbnode(), "Q", un_name(), un_city(), "EBL: Viewing bulletins", " "
  222.  
  223.     ; if the user does something like "b 1", then kbdstuff accordingly
  224.     ;
  225.     numtok = tokcount()
  226.     if (numtok) then
  227.         foo = "B "
  228.         for i = 1 to numtok
  229.             foo = foo + " " + gettoken()
  230.         next i
  231.         kbdstuff foo
  232.         end
  233.     endif
  234.  
  235.     ; get the CNAMES file
  236.     ;
  237.     cnames = readline(pcbdat(), 31)
  238.     if (!exist(cnames)) then
  239.         println cnames + " does not exist.  Bad path in PCBOARD.DAT"
  240.         end
  241.     endif
  242.  
  243.     ; get the BLT menu file (uses the CNAMES file)
  244.     ;
  245.     bltmenu = readline(cnames, (curconf() * 33) + 24)
  246.  
  247.     ; we might want to do something if the menu doesn't exist...
  248.     ;    if (!exist(bltmenu)) then
  249.     ;        println "@X0CWarning!  Bulletin menu does not exist!@X07"
  250.     ;    endif
  251.  
  252.  
  253.     ; get the full BLT.LST pathname (uses the CNAMES file)
  254.     ;
  255.     bltlstfile = readline(cnames, (curconf() * 33) + 25)
  256.     if (!exist(bltlstfile)) then
  257.         ; no bulletins, so stuffing "B" alone should automatically make
  258.         ; pcboard display the "no bulletins" message
  259.         ;
  260.         kbdstuff "B"
  261.         end
  262.     endif
  263.  
  264.     ; calculate number of bulletins
  265.     ;
  266.     numblt = fileinf(bltlstfile, 4) / 30
  267.  
  268.  
  269.     ; check our config file
  270.     ;
  271.     ebl_cfg = ppepath() + "EBL.CFG"
  272.     if (!exist(ebl_cfg)) then
  273.         println "@X0CError!  " + ebl_cfg + " does not exist!@X07"
  274.         end
  275.     endif
  276.  
  277.     ; the first line is used if there is no line in the config file that
  278.     ; corresponds with the current conference.
  279.     ;
  280.     fopen 1, ebl_cfg, O_RD, S_DW
  281.     fdefin 1
  282.  
  283.     fdget foo
  284.     if (lower(foo) == "yes") then
  285.         autopause = TRUE
  286.     else
  287.         autopause = FALSE
  288.     endif
  289.  
  290.     fdget select
  291.  
  292.  
  293.     ; otherwise, get a line, see if the first token corresponds to the
  294.     ; current conference.
  295.     ;
  296.     fdget foo
  297.     found = FALSE
  298.     while (foo != "<eof>") do
  299.         tokenize foo
  300.         foo2 = gettoken()
  301.         if ((lower(foo2) == "main") && (curconf() == 0)) then
  302.             found = TRUE
  303.             break
  304.         else
  305.             confnum = s2i(foo2, 10)
  306.             if ((curconf() != 0) && (confnum == curconf())) then
  307.                 found = TRUE
  308.                 break
  309.             else
  310.                 fdget foo
  311.             endif
  312.         endif
  313.     endwhile
  314.     fclose 1
  315.  
  316.     ; first token matches current conf, so parse the rest of the line to
  317.     ; get the necessary information.
  318.     ;
  319.     if (found) then
  320.         startrow   = s2i(gettoken(), 10)
  321.         startcol   = s2i(gettoken(), 10)
  322.         numskiprow = s2i(gettoken(), 10)
  323.         lb_length  = s2i(gettoken(), 10)
  324.         lb_colour  = gettoken()
  325.     else
  326.         ; if none of the lines has the first token matching the current conf,
  327.         ; then we prompt them the old fashioned way.
  328.         ;
  329.         GetManualInput(select)
  330.     endif
  331.  
  332.     getuser
  333. endproc
  334.  
  335.  
  336.  
  337. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  338. ; get which bulletin to view the old fashioned way.
  339. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  340. procedure GetManualInput(string select)
  341.     string text
  342.  
  343.     newline
  344.     inputstr select, text, @X07, 3, MASK_NUM() + CHR(13), AUTO + NEWLINE
  345.     if (text != "") then
  346.         kbdstuff "B " + text
  347.     endif
  348.  
  349.     end
  350. endproc
  351.  
  352.